home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / archives.swg / 0006_View LZH File.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  4.1 KB  |  149 lines
  1. Program lzhview;
  2.  
  3. Uses
  4.   Dos, Crt;
  5.  
  6. Const
  7.   BSize = 4096;                                  { I/O Buffer Size }
  8.  
  9. Type LZHHead = Record
  10.                  HSize      : Byte;
  11.                  Fill1      : Byte;
  12.                  Method     : Array[1..5] of Char;
  13.                  CompSize   : LongInt;
  14.                  UCompSize  : LongInt;
  15.                  Dos_DT     : LongInt;
  16.                  Fill2      : Word;
  17.                  FileNameLen: Byte;
  18.                  FileName   : Array[1..12] of Char;
  19.                end;
  20.  
  21. Var LZH1       : LZHHead;
  22.     DT         : DateTime;
  23.     FSize,L,C  : LongInt;
  24.     F          : File;
  25.     BUFF       : Array[1..BSize] of Byte;
  26.     DATE       : String[8];                { formatted date as YY/MM/DD }
  27.     TIME       : String[6];                {     "     time as HH:MM }
  28.     RES        : Word;
  29.     DIR        : DirStr;
  30.     FNAME      : NameStr;
  31.     EXT        : ExtStr;
  32.     LZHString,
  33.     SName      : String;
  34.     QUIT       : Boolean;
  35.     SW         : Pointer;
  36.  
  37. Function upper(st:String):String;
  38. Var i : Integer;
  39. begin
  40.   For i := 1 to length(st) do st[i] :=upcase(st[i]);
  41.   upper := st;
  42. end;
  43.  
  44. Function ord_to_str(i:LongInt;j:Byte):String;
  45. Var c:String;
  46. begin
  47.   str(i,c);
  48.   While length(c)<j do c:=' '+c;
  49.   ord_to_str:=c;
  50. end;
  51.  
  52. Procedure FDT(LI:LongInt); { Format Date/Time (time With AM PM) fields }
  53. Var t_ext : String;
  54. begin
  55.   UnPackTime (LI,DT);
  56.   DATE := ord_to_str(DT.Month,2)+'/'+ord_to_str(DT.Day,2)+'/'
  57.          +ord_to_str(DT.Year mod 100,2);
  58.   if DATE[1] = ' ' then DATE[1] := '0';
  59.   if DATE[4] = ' ' then DATE[4] := '0';
  60.   if DATE[7] = ' ' then DATE[7] := '0';
  61.   if DT.Hour in [0..11] then t_ext:='a' else t_ext:='p';
  62.   if DT.Hour in [13..24] then Dec(DT.Hour,12);
  63.   TIME := ord_to_str(DT.Hour,2)+':'+ord_to_str(DT.Min,2);
  64.   if TIME[1] = ' ' then TIME[1] := '0';
  65.   if TIME[4] = ' ' then TIME[4] := '0';
  66.   TIME:=TIME+t_ext;
  67. end;  { FDT }
  68.  
  69. Procedure GET_LZH_ENTRY;
  70. begin
  71.   FillChar(LZH1,SizeOf(LZHHead),#0);
  72.   FillChar (DT,SizeOf(DT),#0);
  73.   L := SizeOf(LZHHead);
  74.   Seek (F,C); BlockRead (F,BUFF,L,RES);
  75.   Move (BUFF[1],LZH1,L);
  76.   With LZH1 do
  77.     if HSize > 0 then
  78.       begin
  79.         Move (FileNameLen,SNAME,FileNameLen+1);
  80.         UnPackTime (Dos_DT,DT);
  81.         FSize := CompSize
  82.       end
  83.     else QUIT := True
  84. end;  { GET_LZH_ENTRY }
  85.  
  86. Procedure DO_LZH (FN : String);
  87. Var fnstr, LZHMeth : String;
  88.     fls,totu,totc : LongInt;
  89. begin
  90.   totu:=0; totc:=0; fls:=0;
  91.   Assign (F,FN);
  92.   {$I-} Reset (F,1); {$I+}
  93.   if Ioresult<>0 then
  94.     begin
  95.       Writeln(upper(FN)+' not found');
  96.       Exit;
  97.     end;
  98.   FSize := FileSize(F);
  99.   C := 0;
  100.   QUIT := False;
  101.   Writeln('LZH File : '+upper(FN));
  102.   Writeln;
  103.   Writeln('  Filename    OrigSize  CompSize   Method     Date  '
  104.   +'   Time');
  105.   Writeln('------------  --------  --------  --------  --------'
  106.   +'  ------');
  107.   Repeat
  108.     GET_LZH_ENTRY;
  109.     if not QUIT then
  110.       begin
  111.         FSplit (SNAME,DIR,FNAME,EXT);
  112.         fnstr:=FNAME+EXT;
  113.         While length(fnstr)<12 do insert(' ',fnstr,length(fnstr)+1);
  114.         FDT(LZH1.Dos_DT);
  115.         inc(totu,lzh1.ucompsize);
  116.         inc(totc,lzh1.compsize);
  117.         inc(fls,1);
  118.         Case LZH1.Method[4] of       {normally only 0,1 or 5}
  119.           '0' : LZHMeth:='Stored  ';
  120.           '1' : LZHMeth:='Frozen 1';
  121.           '2' : LZHMeth:='Frozen 2';
  122.           '3' : LZHMeth:='Frozen 3';
  123.           '4' : LZHMeth:='Frozen 4';
  124.           '5' : LZHMeth:='Frozen 5';
  125.         else LZHMeth:=' Unknown';
  126.         end;
  127.         LZHString:=Fnstr+'  '+ord_to_str(LZH1.UCompsize,8)+'  '+
  128.                    ord_to_str(LZH1.Compsize,8)+'  '+lzhmeth+'  '
  129.                    +DATE+'  '+TIME;
  130.         Writeln(LZHString);
  131.       end;
  132.     Inc (C,FSize+LZH1.HSize+2)
  133.   Until QUIT;
  134.   Close (F);
  135.   Writeln('------------  --------  --------  --------  --------'
  136.   +'  -----');
  137.   Writeln(ord_to_str(fls,5)+' Files   '+ord_to_str(totu,8)+'  '
  138.   +ord_to_str(totc,8));
  139. end;  { DO_LZH }
  140.  
  141. begin
  142.   ClrScr;
  143.   do_lzh('whatever.lzh');  { <-- place Filename here }
  144. end.
  145.  
  146. {
  147. Note the changes in the date processing and compression method display.
  148. Thanks again For the code.
  149. }